home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programmer Power Tools
/
Programmer Power Tools.iso
/
surfmodl
/
surfm203.arc
/
SURFSRC.ARC
/
GETENV.INC
< prev
next >
Wrap
Text File
|
1987-11-15
|
7KB
|
196 lines
{************************************************************************}
Unit MyDos;
{ }
{ VERSION: 1.0c }
{ Author: Kevin Lowey }
{ DATE: 15 Nov. 1987 }
{ }
{ Description: }
{ More DOS and BIOS routines not defined by Turbo Pascal }
{ }
{************************************************************************}
{ }
{ Revision History: }
{ "a" means Alpha version, Not Completed }
{ "b" means Beta Test Version, Completed but in testing }
{ "c" means Completed Version. This version is now frozen }
{ }
{ Date Comment }
{ 15 Nov. 1987 Added CRTMODE function }
{************************************************************************}
Interface
Uses DOS;
{ CRT mode constants not defined by Turbo Pascal}
CONST
{ BW40 = 0; already defined}
{ CO40 = 1; already defined}
{ BW80 = 2; already defined}
{ CO80 = 3; already defined}
{graphics modes}
CGAMCO = 4; { 320 * 200 * 4 colors }
CGAMBW = 5; { 320 * 200 * 4 grey }
CGAH = 6; { 640 * 200 BW}
MONO = 7; {monochrome graphics adapter}
{PC Junior}
JRL16 = 8; { PC Jr. 160 * 200 * 16 colors}
JRM16 = 9; { PC Jr. 320 * 200 * 16 }
JRH4 = 10; { PC Jr. 640 * 200 * 4 }
{EGA card}
EGAM64 = 10; { EGA 640 * 200 * 64 COLORS }
EGAM16 = 13; { EGA 320 * 200 * 16 }
EGAH16 = 14; { EGA 640 * 200 * 16 }
EGAXH4 = 15; { EGA 640 * 350 * 4 }
Function CRTMode : byte; {Current Video Mode}
{Cursor Routines}
Procedure SetCursor (startline,EndLine:Byte); {Set cursor style}
Procedure NoCursor; { Make no cursor show up }
Procedure BoxCursor; { Make the cursor a full box }
Procedure NormCursor; { Returns the cursor to normal }
function get_env (env_var :String) : String; {Read an environment variable}
Implementation
FUNCTION CrtMode : Byte;
VAR
Regs : Registers;
BEGIN {crtmode function}
With Regs do BEGIN
ax := $0F00; {VIDEO_IO function 15}
Intr($10,Regs);
CrtMode := LO(ax);
END;
END; {crtmode function}
{--------------------------------------------------------------------------}
PROCEDURE SetCursor (StartLine,EndLine : byte);
{ This procedure does the actual cursor setting thru the TURBO
INTR procedure. }
VAR
IntrRegs : Registers;
CXRegArray : Array [1..2] of Byte;
CXReg : integer absolute CXRegArray;
BEGIN
CXRegArray[2] := StartLine;
CXRegArray[1] := EndLine;
With IntrRegs do BEGIN
ax := $0100; {ah = 1 means set cursor type}
bx := $0; {bx = page number, zero for us}
cx := CXReg; {ch bits 4 to 0 = start line for cursor}
{cl bits 4 to 0 = end line for cursor}
intr($10,Dos.Registers(IntrRegs)); {set cursor}
END;
END;
{--------------------------------------------------------------------------}
PROCEDURE NoCursor;
{ This procedure calls SetCursor to turn the cursor off }
BEGIN
SetCursor(32,0); {Setting bit 5 turns off cursor}
END;
{--------------------------------------------------------------------------}
PROCEDURE BoxCursor;
{ This procedure calls SetCursor to show a block (box) cursor }
BEGIN
SetCursor(0,13); {0-7 for mono, 0-13 for color}
{but 0-13 works ok for mono too}
END;
{--------------------------------------------------------------------------}
PROCEDURE NormCursor;
{ This procedure calls SetCursor to show the 'normal' cursor }
BEGIN
If CrtMode = 7 then
SetCursor(11,12) {mono}
else
SetCursor(6,7); {color}
END;
{--------------------------------------------------------------------------}
{ This program is a sample on how to control the cursor using TURBO PASCAL
on an IBM or IBM compatable machine. It calls the BIOS VIDEO_IO module
through the standard interupt $10. This will not work with any machine
not supporting the standard interupts into the BIOS roms }
{************************************************************************}
function get_env
(env_var: String) { environment variable to look for }
: String; { Value of environment variable }
{ }
{ Description: }
{ Returns the value associated with the given environment variable }
{ }
{************************************************************************}
{ }
{ Revision History: }
{ "a" means Alpha version, Not Completed }
{ "b" means Beta Test Version, Completed but in testing }
{ "c" means Completed Version. This version is now frozen }
{ }
{************************************************************************}
var
i,j: integer;
result: String;
found: boolean;
table_address: integer;
begin { get_environment }
result := '';
i := 0;
table_address := memW[PrefixSeg:$002c];
if length (env_var) <> 0 then begin
for j := 1 to length(env_var) do begin {convert to uppercase}
if env_var[j] in ['a'..'z'] then begin
env_var[j] := chr(ord(env_var[j])-32);
end; {then}
end; {for}
repeat
result := '';
while (mem[table_address:i]) <> 0 do begin
result := result + chr(mem[table_address:i]);
i := i + 1;
end;
if pos (env_var,result) = 1 then begin
found := true;
result := copy (result,length(env_var) + 1,length(result));
end
else
found := false;
i := i + 1;
until found or (result = '');
end; { Then find value }
get_env := result;
end; {get_env}
begin
end.